home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Adreess Bo226837132001.psc / clsCategories.cls next >
Encoding:
Visual Basic class definition  |  2001-07-13  |  6.6 KB  |  200 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsCategories"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16.  
  17.  
  18. Option Explicit
  19.  
  20. Public USER_CATEGORY As ADODB.Recordset
  21. Public Event ERROR(ByVal MSG As String)
  22.  
  23.  
  24. Private Sub Class_Initialize()
  25.    Set USER_CATEGORY = New ADODB.Recordset
  26. End Sub
  27.  
  28. Private Sub Class_Terminate()
  29.    Set USER_CATEGORY = Nothing
  30. End Sub
  31.  
  32.  
  33. '================================================================
  34. 'USED TH DELETE A CATEGORY
  35. '================================================================
  36. Public Function DELETE_CATEGORY(ByVal CategoryName As String, ByVal User_Name As String) As Boolean
  37.    On Error GoTo DELETE_CATEGORY_ERROR
  38.  
  39.    'Remove all The Contacts Record from CONTACTS_TABLENAME
  40.    TmpString = ""
  41.    TmpString = "DELETE * FROM " & CONTACTS_TABLENAME & _
  42.          " WHERE USER_NAME = '" & User_Name & "'" & _
  43.          " AND CATEGORY_NAME = '" & CategoryName & "'"
  44.  
  45.    PUBLIC_DATABASE.CONNECTION.Execute TmpString
  46.    DoEvents
  47.  
  48.    'Remove all The Contacts Record from CONTACTS_TABLENAME
  49.    TmpString = ""
  50.    TmpString = "DELETE * FROM " & CATEGORIES_TABLENAME & _
  51.          " WHERE USER_NAME = '" & User_Name & "'" & _
  52.          " AND CATEGORY_NAME = '" & CategoryName & "'"
  53.  
  54.    PUBLIC_DATABASE.CONNECTION.Execute TmpString
  55.    DoEvents
  56.  
  57.    DELETE_CATEGORY = True
  58.    Exit Function
  59.  
  60. DELETE_CATEGORY_ERROR:
  61.    If Err.Number <> 0 Then
  62.       MsgBox "ERROR : clsCategories.DELETE_CATEGORY" & vbNewLine & _
  63.             "ERROR # " & Str$(Err.Number) & _
  64.             "DESCRIPTION - " & Err.Description & vbNewLine, vbCritical + vbOKOnly
  65.       Err.Clear
  66.       DELETE_CATEGORY = False
  67.       RaiseEvent ERROR(Err.Description & " : " & Str$(Err.Number))
  68.    End If
  69. End Function
  70. '================================================================
  71.  
  72.  
  73.  
  74. '================================================================
  75. 'USED TO EDIT A CATEGORY
  76. '================================================================
  77. Public Function EDIT_CATEGORY(ByVal OldCategory As String, ByVal NewCategory As String, ByVal User_Name As String) As Boolean
  78.    On Error GoTo EDIT_CATEGORY_ERROR
  79.  
  80.    'Change The Category Names of all the records that matches
  81.    Debug.Print "Renaming The Category Names From " & CONTACTS_TABLENAME
  82.  
  83.    TmpString = ""
  84.    TmpString = "UPDATE " & CONTACTS_TABLENAME & " SET CATEGORY_NAME = '" & Trim$(NewCategory) & "'" & _
  85.          " WHERE USER_NAME = '" & User_Name & "'" & _
  86.          " AND CATEGORY_NAME = '" & OldCategory & "'"
  87.  
  88.    PUBLIC_DATABASE.CONNECTION.Execute TmpString
  89.    DoEvents
  90.  
  91.  
  92.    'Rename Category Name from The CATEGORY TABLE
  93.    Debug.Print "Renaming The Category Names From " & CATEGORIES_TABLENAME
  94.  
  95.    TmpString = ""
  96.    TmpString = "UPDATE " & CATEGORIES_TABLENAME & " SET CATEGORY_NAME = '" & Trim$(NewCategory) & "'" & _
  97.          " WHERE USER_NAME = '" & User_Name & "'" & _
  98.          " AND CATEGORY_NAME ='" & OldCategory & "'"
  99.  
  100.    PUBLIC_DATABASE.CONNECTION.Execute TmpString
  101.    DoEvents
  102.  
  103.    EDIT_CATEGORY = True
  104.  
  105. EDIT_CATEGORY_ERROR:
  106.    If Err.Number <> 0 Then
  107.       MsgBox "ERROR : clsCategories.EDIT_CATEGORY" & vbNewLine & _
  108.             "ERROR # " & Str$(Err.Number) & _
  109.             "DESCRIPTION - " & Err.Description & vbNewLine, vbCritical + vbOKOnly
  110.       Err.Clear
  111.       EDIT_CATEGORY = False
  112.       RaiseEvent ERROR(Err.Description & " : " & Str$(Err.Number))
  113.    End If
  114. End Function
  115. '================================================================
  116.  
  117.  
  118.  
  119.  
  120. '================================================================
  121. 'USED TO ADD A New CATEGORY
  122. '================================================================
  123. Public Function ADD_CATEGORY(ByVal CategoryName As String, ByVal User_Name As String) As Boolean
  124.    On Error GoTo ADD_CATEGORY_ERROR
  125.  
  126.    Debug.Print "Adding A New Category For"
  127.    'Initialise The Recordset
  128.    Set TmpRecordSet = New ADODB.Recordset
  129.  
  130.    tmpSQL = ""
  131.    tmpSQL = "SELECT USER_NAME,CATEGORY_NAME FROM " & CATEGORIES_TABLENAME & _
  132.          " WHERE USER_NAME = '" & User_Name & "'"
  133.  
  134.    'OPEN THE Categories Table
  135.    TmpRecordSet.Open tmpSQL, PUBLIC_DATABASE.CONNECTION, adOpenKeyset, adLockOptimistic
  136.  
  137.    TmpRecordSet.AddNew
  138.    TmpRecordSet.Fields("USER_NAME") = CURRENT_USER.LOGIN_NAME
  139.    TmpRecordSet.Fields("CATEGORY_NAME") = Trim$(CategoryName)
  140.    TmpRecordSet.Update   'UPDATE
  141.    TmpRecordSet.Requery   'REQUERY
  142.    TmpRecordSet.Close   'CLOSE
  143.    Set TmpRecordSet = Nothing
  144.  
  145.    ADD_CATEGORY = True
  146.    Exit Function
  147.  
  148. ADD_CATEGORY_ERROR:
  149.    If Err.Number <> 0 Then
  150.       MsgBox "ERROR : clsCategories.ADD_CATEGORY" & vbNewLine & _
  151.             "ERROR # " & Str$(Err.Number) & _
  152.             "DESCRIPTION - " & Err.Description & vbNewLine, vbCritical + vbOKOnly
  153.       Err.Clear
  154.       ADD_CATEGORY = False
  155.       RaiseEvent ERROR(Err.Description & " : " & Str$(Err.Number))
  156.    End If
  157. End Function
  158. '================================================================
  159.  
  160.  
  161.  
  162. '================================================================
  163. 'Used to Check If a CATEGORY NAME ALREADY EXIST
  164. '================================================================
  165. Public Function USER_CATEGORY_EXIST(ByVal CATEGORY_NAME As String, ByVal User_Name As String) As Boolean
  166.    Dim TmpRecordSet As ADODB.Recordset
  167.    On Error GoTo USER_CATEGORY_EXIST_ERROR
  168.  
  169.    Set TmpRecordSet = New ADODB.Recordset
  170.  
  171.    tmpSQL = ""
  172.    tmpSQL = "SELECT CATEGORY_NAME FROM " & CATEGORIES_TABLENAME & _
  173.          " WHERE USER_NAME = '" & User_Name & "'" & _
  174.          " AND CATEGORY_NAME = '" & CATEGORY_NAME & "'"
  175.  
  176.    TmpRecordSet.Open tmpSQL, PUBLIC_DATABASE.CONNECTION, adOpenKeyset, adLockOptimistic
  177.    DoEvents
  178.  
  179.    If TmpRecordSet.RecordCount > 0 Then
  180.       USER_CATEGORY_EXIST = True
  181.    Else
  182.       USER_CATEGORY_EXIST = False
  183.    End If
  184.  
  185.    tmpSQL = ""
  186.    Set TmpRecordSet = Nothing
  187.    Exit Function
  188.  
  189. USER_CATEGORY_EXIST_ERROR:
  190.    If Err.Number <> 0 Then
  191.       MsgBox "USER_CATEGORY_EXIST_ERROR : " & Err.Description & vbNewLine & " - Error# " & Str$(Err.Number), vbCritical + vbOKOnly
  192.       Err.Clear
  193.       Set TmpRecordSet = Nothing
  194.       USER_CATEGORY_EXIST = True
  195.       RaiseEvent ERROR(Err.Description & " : " & Str$(Err.Number))
  196.    End If
  197. End Function
  198. '================================================================
  199. '================================================================
  200.